       implicit double precision (a-h,o-z)
       dimension y(1), work(17), icom(4)
       external thermo
       common etherm,ifeval,j

       open(2,file=' ',status='new')
       ifeval=0
       icom(1)=0
       icom(2)=0
       icom(3)=0
       neqn=1
       write(*,*) 'etherm=, imeth=, tola=, tolr='
       read(*,*) etherm,imeth,tola,tolr
       hstart=0.01d0
       y(1)=1.d0
       x0=0.d0
       xb=0.d0
       do 20 j=1,6
	 xa=xb
	 xb=0.2d0*dble(j)+x0
	 abserr=dexp(-etherm*xa)-y(1)
	 relerr=abserr/dexp(-etherm*xa)
	 write(2,100)xa,y(1),abserr,relerr
	 call runkut(xa,y,xb,neqn,tola,tolr,hstart,work,
     &		     imeth,ierror,icom,thermo)
	 if(ierror.GT.1) then
	   write(2,100)xb,y(1),abserr,relerr
	   write(2,*)' ERROR-Problem too stiff or is discontinous'
	   close(2)
	   stop
	 end if
20     continue
       if(icom(4).GT.0) write(2,*) 'Round-off error possible'
       write(2,*) 'Number of function evaluations = ',ifeval
       close (2)
       stop
100    format(F10.5,4E14.6)
       end
c**********************************************************************
       subroutine thermo (x,y,yprime,neqn)
       implicit double precision (a-h,o-z)
       dimension y(neqn), yprime(neqn)
       common etherm,ifeval,j

       yprime(1)= -etherm*y(1)
       if(j.LE.5) ifeval=ifeval+1
       return
       end
